home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / kcl / kcl.lha / c / lex.c < prev    next >
C/C++ Source or Header  |  1987-06-04  |  2KB  |  114 lines
  1. /*
  2. (c) Copyright Taiichi Yuasa and Masami Hagiya, 1984.  All rights reserved.
  3. Copying of this file is authorized to users who have executed the true and
  4. proper "License Agreement for Kyoto Common LISP" with SIGLISP.
  5. */
  6.  
  7. /*
  8.  
  9.     lex.c
  10.  
  11.     lexical environment
  12. */
  13.  
  14. #include "include.h"
  15.  
  16.  
  17. object
  18. assoc_eq(key, alist)
  19. object key, alist;
  20. {
  21.     while (!endp(alist)) {
  22.         if (MMcaar(alist) == key)
  23.             return(MMcar(alist));
  24.         alist = MMcdr(alist);
  25.     }
  26.     return(Cnil);
  27. }
  28.  
  29. lex_fun_bind(name, fun)
  30. object name, fun;
  31. {
  32.     object *top = vs_top;
  33.  
  34.     vs_push(make_cons(fun, Cnil));
  35.     top[0] = make_cons(Sfunction, top[0]);
  36.     top[0] = make_cons(name, top[0]);
  37.     lex_env[1] = make_cons(top[0],lex_env[1]);
  38.     vs_top = top;
  39. }
  40.  
  41. lex_macro_bind(name, exp_fun)
  42. object name, exp_fun;
  43. {
  44.     object *top = vs_top;
  45.     vs_push(make_cons(exp_fun, Cnil));
  46.     top[0] = make_cons(Smacro, top[0]);
  47.     top[0] = make_cons(name, top[0]);
  48.     lex_env[1]=make_cons(top[0], lex_env[1]);              
  49.     vs_top = top;
  50. }
  51.  
  52. lex_tag_bind(tag, id)
  53. object tag, id;
  54. {
  55.     object *top = vs_top;
  56.  
  57.     vs_push(make_cons(id, Cnil));
  58.     top[0] = make_cons(Stag, top[0]);
  59.     top[0] = make_cons(tag, top[0]);
  60.     lex_env[2] =make_cons(top[0], lex_env[2]);
  61.     vs_top = top;
  62. }
  63.  
  64. lex_block_bind(name, id)
  65. object name, id;
  66. {
  67.     object *top = vs_top;
  68.  
  69.     vs_push(make_cons(id, Cnil));
  70.     top[0] = make_cons(Sblock, top[0]);
  71.     top[0] = make_cons(name, top[0]);
  72.     lex_env[2]= make_cons(top[0], lex_env[2]);
  73.     vs_top = top;
  74. }
  75.  
  76. object
  77. lex_tag_sch(tag)
  78. object tag;
  79. {
  80.     object alist = lex_env[2];
  81.  
  82.     while (!endp(alist)) {
  83.         if (eql(MMcaar(alist), tag) && MMcadar(alist) == Stag)
  84.             return(MMcar(alist));
  85.         alist = MMcdr(alist);
  86.     }
  87.     return(Cnil);
  88. }
  89.  
  90. object lex_block_sch(name)
  91. object name;
  92. {
  93.     object alist = lex_env[2];
  94.  
  95.     while (!endp(alist)) {
  96.         if (MMcaar(alist) == name && MMcadar(alist) == Sblock)
  97.             return(MMcar(alist));
  98.         alist = MMcdr(alist);
  99.     }
  100.     return(Cnil);
  101. }
  102.  
  103. init_lex()
  104. {
  105.     Sfunction = make_ordinary("FUNCTION");
  106.     enter_mark_origin(&Sfunction);
  107.     Smacro = make_ordinary("MACRO");
  108.     enter_mark_origin(&Smacro);
  109.     Stag = make_ordinary("TAG");
  110.     enter_mark_origin(&Stag);
  111.     Sblock =  make_ordinary("BLOCK");
  112.     enter_mark_origin(&Sblock);
  113. }
  114.